.TITLE	XXPRE
	.IDENT	/01.01/

;
; Copyright (c) 1995-1999 by Mentec, Inc., U.S.A.
; All rights reserved
;
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
; K. L. NOEL 17-MAR-87
;
; MODIFIED FOR CPRSX V2.0 BY:
;
;	PAUL K. M. WEISS	16-JUN-1989	1.01
;
;		PKW1811	- BUFFER ACP QIOS AND SMALL READ/WRITES IN CPR PACKET
;
; PREPROCESSOR MODULE FOR NON TERMINAL DEVICES
;
;
	.PAGE
;
; LOCAL MACROS
;
	.MACRO	EVEN	A
	INC	A
	BIC	#1,A
	.ENDM
;
; LOCAL SYMBOL DEFINITION
;
	MAP5	=	120000  ; ADDRESS OF FIRST WORD IN APR5
	MAP6	=	140000	; ADDRESS OF FIRST WORD IN APR6
	.PAGE
;+
; 
; I/O FUNCTION CODE DISPATCH TABLE
;
;-

DSPTBL: .WORD	FC0BF		; 0  IO.KIL
	.WORD	FC1BF		; 1  IO.WLB
	.WORD	FC1BF		; 2  IO.RLB
	.WORD	FCATT		; 3  IO.ATT
	.WORD	FC0BF		; 4  IO.DET
	.WORD	FC0BF		; 5  ?
	.WORD	FC0BF		; 6  ?
	.WORD	FC0BF		; 7  IO.CLN

	.WORD	FCIFC		;10-ILLEGAL FUNCTION
	.WORD	FCPKT		;11-FIND FILE NAME IN DIRECTORY
	.WORD	FCIFC		;12-UNLOCK BLOCK - NOP'D IN MASK
	.WORD	FCPKT		;13-REMOVE FILE NAME FROM DIRECTORY
	.WORD	FCPKT		;14-ENTER FILE NAME IN DIRECTORY
	.WORD	FCACC		;15-ACCESS FILE FOR READ
	.WORD	FCACC		;16-ACCESS FILE FOR READ AND WRITE
	.WORD	FCACC		;17-ACCESS FILE FOR READ, WRITE, AND EXT
	.WORD	FCDAC		;20-DEACCESS FILE
	.WORD	FC1BF		;21-READ VIRTUAL BLOCK
	.WORD	FC1BF		;22-WRITE VIRTUAL BLOCK
	.WORD	FCPKT		;23-EXTEND FILE
	.WORD	FCCRE		;24-CREATE FILE
	.WORD	FCPKT		;25-MARK FILE FOR DELETE/TRUNCATE FILE
	.WORD	FCPKT		;26-READ FILE ATTRIBUTES
	.WORD	FCPKT		;27-WRITE FILE ATTRIBUTES
	.WORD	FCPKT		;30-USER MAGTAPE CONTROL FUNCTION
	.WORD	NTWVB		;31-TRANSMIT PROCESS MESSAGE
	.WORD	NTRVB		;32-RECEIVE PROCESS MESSAGE
	.WORD	NTACC		;33-CONNECT TO PROCESS
	.WORD	NTDAC		;34-DISCONNECT FROM PROCESS
	.WORD	NTNCT		;35-NETWORK CONTROL FUNCTION
	.WORD	FCIFC		;36-ILLEGAL FUNCTION
	.WORD	FCIFC		;37-ILLEGAL FUNCTION


	.PAGE

;
; ILLEGAL FUNCTION
;

FCIFC:	.WORD	IEIFC		;SET ILLEGAL FUNCTION STATUS

;
; ATTACH PROCESSING
;
FCATT:
	.WORD	SETRSW		; BLOCK TASK TO APPEAR SYNCHRONOUS.
	.WORD	CK0XT		; EXIT WITH 0 BUFFERS IN FLAG BYTE.
;
; NON ACP FUNCTION WITH NO BUFFERS
;
FC0BF:	.WORD	CK0XT		;EXIT WITH 0 BUFFER IN FLAG BYTE
;
; NON ACP FUNCTION WITH ONE BUFFER
;
FC1BF:	.WORD	CHKBUF		;BUFFER THE REQUEST IN CPRBUF IF APPROPRIATE
	.WORD	CK1XT		;EXIT WITH 1 BUFFER IN FLAG BYTE
;
; ACCESS FILE FOR READ, READ/WRITE, OR READ/WRITE/EXTEND
;

FCACC:
	.WORD	CKALN		;CHECK IF FILE ALREADY ACCESSED ON LUN
	.WORD	BDPKT		;BUILD AN I/O PACKET
	.WORD	CKLHD		;LOCK DOWN HEADER
	.WORD	CKRLK		;SYNCHRONIZE ACCESS
	.WORD	CK1XC		;EXIT CONDITIONALLY WITH 1 BUFFER IN FLAG BYTE

;
; DEACCESS FILE
;

FCDAC:	.WORD	CKNLN		;CHECK IF FILE ACCESSED ON LUN
	.WORD	BDPKT		;BUILD AN I/O PACKET
	.WORD	CKLHD		;LOCK DOWN HEADER
	.WORD	CKRLK		;SYNCHRONIZE ACCESS
	.WORD	CK1XC		;EXIT CONDITIONALLY WITH 1 BUFFER IN FLAG BYTE
;
; CREATE FILE
;	CREATE & ACCESS NOT LEGAL COMBINATION
;	CREATE & EXTEND DOES NOT INCR PENDING COUNT
;		SINCE NO WINDOW
;

FCCRE:
	.WORD	CKALN		;CHECK IF FILE ALREADY ACCESSED ON LUN
;
; BUILD AN I/O PACKET FOR FIND, ENTER, REMOVE, EXTEND, DELETE, READ
; ATTRIBUTES, AND WRITE ATTRIBUTES
;
FCPKT:
	.WORD	BDPKT		;BUILD AN I/O PACKET
	.WORD	CKLHD		;LOCK DOWN HEADER
	.WORD	CK1XC		;EXIT CONDITIONALY WITH ONE BUFFER IN BYTE

;
; TABLE OF SPECIAL FUNCTION CODES TO BE CHECKED BY SOFTWARE WRITE LOCK
;

WLKTB:
				;DEVICE DEPENDENT CODES
	.WORD	IO.SMD		;SET MEDIA DENSITY
	.WORD	IO.EOF		;WRITE END OF FILE
	.WORD	IO.ERS		;ERASE TAPE
	.WORD	IO.DSE		;DATA SECURITY ERASE

				;DIAGNOSTIC CODES
	.WORD	IO.WDH		;WRITE DATA AND HEADER
	.WORD	IO.WTD		;WRITE TRACK DESCRIPTOR
	.WORD	IO.TDD		;WRITE TRACK DESCRIPTOR DISPLACED
	.WORD	IO.CEW		;WRITE BLOCK ON CE TRACK

	.WORD	0		;TERMINATOR FOR WRITE LOCK TABLE

NTWVB:				; NETWORK SEND AND SEND INTERRUPT.
	.WORD	CKNLN		; ENSURE FILE IS OPEN ON LUN.
	.WORD	PRMPRP		; PREPARE PARAMETERS.
	.WORD	CKBFR1		; CHECK BUFFER ONE FOR READ ACCESS.
	.WORD	CK1XT		; INDICATE ONE BUFFER AND LEAVE.

NTRVB:				; NETWORK RECEIVE.
	.WORD	CKNLN		; ENSURE FILE IS OPEN ON LUN.
	.WORD	PRMPRP		; PREPARE PARAMETERS.
	.WORD	CKBFW1		; CHECK BUFFER ONE FOR WRITE ACCESS.
	.WORD	CK1XT		; INDICATE ONE BUFFER AND LEAVE.

NTACC:				; NETWORK ACCEPT AND CONNECT.
	.WORD	CKALN		; ENSURE NO FILE IS OPEN ON LUN.
	.WORD	PRMPRP		; PREPARE PARAMETERS.
MERGE:				; MERGE FROM REJECT.
	.WORD	CKBFR2		; CHECK BUFFER TWO FOR READ ACCESS.
	.WORD	CKBFR1		; CHECK BUFFER ONE FOR READ ACCESS.
	.WORD	ACSPL		; HANDLE SPECIAL ACCEPT/CONNECT PROCESSING.
	.WORD	CKLHD		; LOCK DOWN HEADER.
	.WORD	CKRLK		; INTERLOCK.
	.WORD	CKNXT		; EXIT WITH SEVERAL BUFFERS.

NTDAC:				; NETWORK ABORT, DISCONNECT, AND REJECT.
	.WORD	CKNLN		; ENSURE FILE IS OPEN ON LUN.
	.WORD	PRMPRP		; PREPARE PARAMETERS.
	.WORD	ADRSPL		; DO SPECIAL ACCEPT/DISCONNECT/REJECT STUFF.
				; REJECT GOES TO MERGE AT THIS POINT.
	.WORD	CKBFR1		; CHECK BUFFER ONE FOR READ ACCESS.
	.WORD	CKLHD		; LOCK DOWN HEADER.
	.WORD	CKRLK		; INTERLOCK.
	.WORD	CK1XT		; INDICATE ONE BUFFER AND LEAVE.

NTNCT:				; NETWORK CLOSE, GET LOCAL NODE INFORMATION,
				; GET NETWORK DATA, OPEN, AND SPECIFY AST.
	.WORD	NCTSPL		; SEPARATE PROCESSING AS NECESSARY.
				; GET NETWORK DATA AND GET LOCAL NODE
				; INFORMATION TO GO NTRVB.
				; OPEN AND CLOSE FALL THROUGH, ANYTHING ELSE
				; GOES TO SKIP.
	.WORD	INSTSK		; INSERT TASK NAME.
	.WORD	CKLHD		; LOCK DOWN HEADER.
	.WORD	CKRLK		; INTERLOCK.
SKIP:
	.WORD	CK0XT		; INDICATE NO BUFFERS AND LEAVE.

SAVATT:	.BLKW	13.		; SAVE ATTRIBUTE DESCRIPTORS - MAX OF 6

	.PAGE
XXPRE::
	SAVNR
	MOV	R1,-(SP)	;SAVE I/O PACKET ADDRESS FOR ERROR RETURN
	CLR	-(SP)		;SAVE ADDRESS OF CPRBUF PACKET FOR ERRORS
	MOV	SP,$TEMP0	;REMEMBER WHERE THE STACK GOES
;
; PREPARE REGISTERS FOR POLISH DISPATCH ROUTINES
;
	MOV	R1,R4		;PUT I/O PACKET ADDRESS IN R4
	MOVB	I.FCN+1(R1),R2	;RETRIEVE I/O FUNCTION CODE
	ASL	R2		;CONVERT TO WORD INDEX
	MOV	R5,-(SP)	;SAVE UCB ADDRESS FOR POLISH ROUTINES
	MOV	R5,R0		;
	MOV	I.LN2(R4),R1    ;SAVE ADDRESS OF SECOND LUN WORD
	MOV	R1,-(SP)	;FOR POLISH ROUTINES
	MOV	DSPTBL(R2),R5	;GET ADDRESS OF POLISH VECTOR
	JMP	@(R5)+		;EXECUTE POLISH ROUTINE
;
;	REGISTERS AT POLISH DISPATCH ROUTINES
;
;	R0 -	UCB
;	R1 -	ADDRESS 2ND LUN WORD
;	R4 -	POINTER TO I/O PACKET
;
;	SP->	2ND LUN WORD ADDRESS
;		UCB ADDRESS
;
; TASK HEADER IS ASSUMED TO BE MAPPED FOR ALL OF THE THREADED CODE ROUTINES
;
;
; CHECK FOR FILE ALREADY ACCESSED ON LUN
;

CKALN:  TST	(R1)		;FILE ACCESSED ON LUN?
	BEQ	CKJR5		;IF EQ NO
	JMP	IEALN		;ERROR

;
; CHECK FOR FILE ACCESSED ON LUN
;

CKNLN:  TST	(R1)		;FILE ACCESSED ON LUN?
	BNE	CKJR5		;IF NE YES
	JMP	IENLN		;ERROR
;
; SET ACCESS/DEACCESS INTERLOCK
;

CKRLK:  INC	@(SP)		;SET ACCESS/DEACCESS PENDING INTERLOCK

CKJR5:	JMP	@(R5)+

;
; CHECK BUFFER SIZE AGAINST $CPMXB.  IF SMALLER OR SAME, ALLOCATE CPRBUF NOW
; AND REPLACE I.PRM AND I.PRM+2 WITH THE BIAS AND OFFSET OF THE PACKET.  IF THE
; FUNCTION IS A READ, STORE THE USER BIAS AND ADDRESS IN THE PACKET TO RESTORE 
; THE DATA UPON RETURN FROM VMS.  IF IT'S A WRITE, COPY THE DATA INTO THE CPRBUF
; PACKET. 
;
; AT SOME POINT THIS PROBABLY SHOULD CALL THE EXEC BUFFERED I/O ROUTINES SO THE
; REGIONS ARE NOT LOCKED DOWN DURING THE QIO, BUT WE DON'T HAVE THE TIME FOR 
; THAT NOW.  DON'T FORGET THAT IF THIS IS DONE, THE USER ADDRESS MUST BE STORED
; AND RE-RELOCTED RATHER THAN STORING THE BIAS/OFFSET.
;
; AT SOME OTHER POINT, IT MIGHT BE USEFUL TO BUFFER OVERLAY LOADS.  BUT
; AGAIN, NOT NOW.
;
CHKBUF:
	CMP	#IO.LOV,I.FCN(R4)	;IS IT THE I-SPACE LOAD OVERLAY?
	BEQ	CKJR5			;IF EQ YES, DON'T BUFFER
	CMP	#IO.LDO,I.FCN(R4)	;IS IT THE D-SPACE LOAD OVERLAY?
	BEQ	CKJR5			;IF EQ YES, DON'T BUFFER
	MOV	I.PRM+4(R4),R1		;GET SIZE OF TRANSFER
	CMP	R1,$CPMXB		;IS SIZE <= MAX BUFFER SIZE?
	BHI	CKJR5			;NOPE, JUST EXIT
	ADD	#177,R1			;ROUND TO NEXT BLOCK, ADD ONE FOR HEADER
	ASH	#-6,R1			;32 WORD BLOCK
	CLR	R0			;NO FLAGS
	CALL	$CPALO			;GET A BLOCK OF CPRBUF
	BCS	CKJR5			;COULDN'T GET ONE, FORGET BUFFERING
	MOV	R0,@$TEMP0		;SAVE BUFFER IN CASE OF FAILURE
	MOV	I.PRM(R4),R1		;BIAS OF USER BUFFER
	MOV	I.PRM+2(R4),R2		;OFFSET OF USER BUFFER
	MOV	R0,I.PRM(R4)		;MAKE THE BIAS THE BASE OF THE PACKET
	MOV	#100,I.PRM+2(R4)	;OFFSET 100 FROM BASE OF PACKET
	CMPB	#<IO.RLB/256.>,I.FCN+1(R4)	;IS THIS READ LOGICAL BLOCK?
	BEQ	20$			;YES, DON'T BLXIO, SAVE USER ADDR/BIAS
	CMPB	#<IO.RVB/256.>,I.FCN+1(R4)	;HOW ABOUT READ VIRTUAL BLOCK?
	BEQ	20$			;YES, DON'T BLXIO, SAVE USER ADDR/BIAS
	MOV	R0,R3			;MOVE CPR PACKET BIAS
	SUB	#20000,R2		;MAKE USER OFFSET INTO APR5 OFFSET
	MOV	I.PRM+4(R4),R0		;GET LENGTH OF BUFFER
	MOV	R4,-(SP)		;SAVE IO PACKET
	MOV	#MAP6+100,R4		;START WITH SECOND BLOCK OF CPR PACKET
	CALL	$BLXIO			;COPY THE BUFFER
	MOV	(SP)+,R4		;RESTORE IO PACKET	
	BR	30$			;JOIN COMMON CODE TO EXIT

20$:	MOV	@#KISAR6,R3		;SAVE CURRENT APR6 MAPPING
	MOV	R0,@#KISAR6		;MAP CPR PACKET
	MOV	R1,MAP6+P$LUN+32	;SAVE USER BIAS
	MOV	R2,MAP6+P$LUN+34 	;SAVE USER OFFSET
	MOV	R3,@#KISAR6		;RESTORE APR6 MAPPING

30$:	MOV	(SP),R1			;RESTORE SECOND LUN WORD
	MOV	2(SP),R0		;RESTORE UCB ADDRESS
	JMP	@(R5)+			;LEAVE

PRMPRP:					; PREPARE NETWORK PARAMETERS.
	MOV	I.PRM+12(R4),I.PRM+16(R4)	; WILL BE ADJUSTED LATER.
	MOV	I.PRM+10(R4),I.PRM+14(R4)
	MOV	I.PRM+6(R4),I.PRM+12(R4)
	MOV	I.PRM+4(R4),I.PRM+6(R4)
	MOV	I.PRM+2(R4),I.PRM+4(R4)
	JMP	@(R5)+			; LEAVE.

	.ENABL	LSB
CKBFR2:				; CHECK BUFFER TWO FOR READ ACCESS.
	MOV	#I.PRM+6,R3	; SET OFFSET TO SECOND ADDRESS.
	BR	10$
CKBFR1:				; CHECK BUFFER ONE FOR READ ACCESS.
	MOV	#I.PRM,R3	; SET OFFSET TO FIRST ADDRESS.
10$:
	ADD	R4,R3		; POINT TO ADDRESS.
	MOV	R1,-(SP)	; SAVE REGISTERS.
	MOV	R0,-(SP)
	MOV	(R3),R0		; GET ADDRESS TO CHECK.
	MOV	4(R3),R1	; GET LENGTH.
	BEQ	50$		; YES, ACCEPT IT.
	CALL	CKBFR		; CHECK BUFFER FOR WRITE ACCESS.
	BCS	IER0		; ERROR CODE IS IN R0.
	MOV	R1,(R3)+	; PUT APR IN PACKET.
	MOV	R2,(R3)		; PUT OFFSET IN PACKET.
50$:
	MOV	(SP)+,R0	; RESTORE REGISTERS.
	MOV	(SP)+,R1
	JMP	@(R5)+		; LEAVE.
	.DSABL	LSB

	.ENABL	LSB
CKBFW3:				; CHECK BUFFER THREE FOR WRITE ACCESS.
				; THIS IS CUSTOMIZED FOR THE NETWORK DEVICE.
	MOV	#I.PRM+14,R3	; SET OFFSET TO THIRD ADDRESS.
	MOV	R1,-(SP)	; SAVE REGISTER.
	MOV	I.PRM+16(R4),R1	; GET LENGTH TO USE.
	CMP	R1,#20		; IS LENGTH ACCEPTABLE?
	BHI	IEBAD		; NO, SIGNAL ERROR.
	CMP	I.PRM+12(R4),#20
				; IS SECOND LENGTH ACCEPTABLE?
	BHI	IEBAD		; NO, SIGNAL ERROR.
	ADD	R1,I.PRM+4(R4)	; HACK FIRST LENGTH TO INCLUDE THIRD BUFFER.
	ADD	I.PRM+12(R4),I.PRM+4(R4)
				; HACK FIRST LENGTH TO REPRESENT TOTAL.
	MOVB	R1,I.PRM+13(R4)	; COMBINE TWO LENGTHS IN ONE WORD.
	BR	10$
CKBFW1:				; CHECK BUFFER ONE FOR WRITE ACCESS.
	MOV	#I.PRM,R3	; SET OFFSET TO FIRST ADDRESS.
	MOV	R1,-(SP)	; SAVE REGISTER.
	MOV	I.PRM+4(R4),R1	; GET LENGTH TO USE.
10$:
	ADD	R4,R3		; POINT TO ADDRESS.
	MOV	R0,-(SP)	; SAVE REGISTER.
	MOV	(R3),R0		; GET ADDRESS TO CHECK.
	TST	R1		; IS LENGTH ZERO?
	BEQ	50$		; YES, ACCEPT IT.
	CALL	CKBFB		; CHECK BUFFER FOR WRITE ACCESS.
	BCS	IER0		; ERROR CODE IS IN R0.
	MOV	R1,(R3)+	; PUT APR IN PACKET.
	MOV	R2,(R3)		; PUT OFFSET IN PACKET.
50$:
	MOV	(SP)+,R0	; RESTORE REGISTERS.
	MOV	(SP)+,R1
	JMP	@(R5)+		; LEAVE.
	.DSABL	LSB

ACSPL:				; SPLIT ACCEPT AND CONNECT.
	BIT	#10,I.FCN(R4)	; IS THIS AN ACCEPT (FUNCTION 15410 OR 15610)?
	BNE	10$		; YES, SKIP CONNECT PROCESSING.
	MOV	#1,R1		; LIE ABOUT NUMBER OF BUFFERS.
	JMP	CKBFW3		; CHECK BUFFER THREE FOR WRITE ACCESS.
10$:
	MOV	#11,R1		; INDICATE TWO BUFFERS.
	JMP	@(R5)+		; LEAVE.

ADRSPL:				; SPLIT ABORT, DISCONNECT, AND REJECT.
	CMP	#16020,I.FCN(R4)
				; IS THIS A REJECT?
	BNE	10$		; NO, CONTINUE.
	MOV	#MERGE,R5	; YES, SEND EXECUTION TO NEW LOCATION.
10$:
	JMP	@(R5)+		; LEAVE.

NCTSPL:				; SPLIT NETWORK CONTROL FUNCTIONS.
	MOV	I.FCN(R4),R1	; GET FUNCTION CODE.
	BIC	#177707,R1	; EXTRACT THREE BITS INDICATING FUNCTION.
	ASR	R1
	ASR	R1
	TST	NCTTBL(R1)	; IS THERE A SPECIAL LOCATION TO GO TO?
	BEQ	10$		; NO, CONTINUE.
	MOV	NCTTBL(R1),R5	; YES, FETCH IT.
10$:
	JMP	@(R5)+		; LEAVE.

NCTTBL:
	.WORD	0		; 00, OPEN
	.WORD	0		; 10, CLOSE
	.WORD	SKIP		; 20, SPECIFY AST
	.WORD	NTRVB		; 30, GET NETWORK DATA
	.WORD	NTRVB		; 40, GET NETWORK DATA
	.WORD	NTRVB		; 50, GET NETWORK DATA
	.WORD	FCIFC		; 60
	.WORD	NTRVB		; 70, GET LOCAL NODE INFORMATION

;
; INSERT TASK NAME.
;
INSTSK:
	MOV	I.TCB(R4),R1		; FIND TCB.
	MOV	T.NAM(R1),I.PRM+4(R4)	; PUT NAME IN PARAMETERS 3 AND 4.
	MOV	T.NAM+2(R1),I.PRM+6(R4)	;
	JMP	@(R5)+			; CONTINUE.

;
; ERROR ROUTINES
;
;
; FUNCTION IS AN ILLEGAL FUNCTION-DECLARE ILLEGAL FUNCTION CODE STATUS
;

IEIFC:  MOV	#IE.IFC&377,R4	;SET ILLEGAL FUNCTION
	JMP	IECMN
;
; ILLEGAL BUFFER ADDRESS SPECIFIED-DECLARE ILLEGAL BUFFER STATUS
;

IESPC:	MOV	#IE.SPC&377,R4	;SET ILLEGAL BUFFER CODE
IECOM:	BR	IECMN		;

;
; ILLEGAL BYTE COUNT OR ALIGNMENT-DECLARE ODD BYTE STATUS
;

IEBYT:	MOV	#IE.BYT&377,R4	;SET ODD BYTE STATUS
	BR	IECMN		;

;
; NO BUFFER SPACE AVAILABLE-SET NO BUFFER AVAILABLE STATUS
;

IENOD:	MOV	#IE.NOD&377,R4	;SET NO BUFFER AVAILABLE CODE
	BR	IECMN		;

;
; BAD PARAMETER-SET BAD PARAMETER STATUS
;

IEBAD:	MOV	#IE.BAD&377,R4	;SET BAD PARAMETER CODE
	BR	IECMN		;

;
; PRIVILEGE VIOLATION-SET PRIVILEGE VIOLATION STATUS
;

IEPRI:	MOV	#IE.PRI&377,R4	;SET PRIVILEGE VIOLATION CODE
	BR	IECMN		;

;
; FILE ALREADY ACCESSED ON LUN-SET FILE ALREADY ACCESSED STATSU
;

IEALN:	MOV	#IE.ALN&377,R4	;SET FILE ALREADY ACCESSED CODE
	BR	IECMN		;

;
; NO FILE ACCESSED ON LUN-SET NO FILE ACCESSED STATUS
;

IENLN:	MOV	#IE.NLN&377,R4	;SET NO FILE ACCESSED STATUS
	BR	IECOM		;
;
; RANDOM ERROR WITH STATUS IN R0
;

IER0:			
	MOV	R0,R4	
;
; COMMON ERROR EXIT
;

IECMN:	MOV	$TEMP0,SP	;RESET STACK POINTER
	MOV	(SP)+,R0	;RETRIEVE ADDRESS OF SECONDARY CONTROL B
	BEQ	10$		;IF EQ NONE
	CALL	$CPDEA		;DEALLOCATE CPRBUF PACKET
10$:	MOV	R4,R0		;SET FINAL I/O STATUS
	CLR	R1		;CLEAR SECOND I/O STATUS WORD
	MOV	(SP)+,R3	;RETRIEVE ADDRESS OF I/O PACKET
	MOV	I.UCB(R3),R5	;RETRIEVE UCB ADDRESS
	SEC			;INDICATE ERROR
	RETURN

;
; BUILD AN I/O PACKET
;

BDPKT:
;
; SPREAD OUT PARAMETERS
;
	MOV	I.PRM+12(R4),I.PRM+16(R4) ;COPY FNB ADDRESS
	MOV	I.PRM+10(R4),I.PRM+14(R4) ;COPY P5
	MOV	I.PRM+6(R4),I.PRM+12(R4)  ;COPY P4
	MOV	I.PRM+4(R4),I.PRM+10(R4)  ;COPY P3
	MOV	I.PRM+2(R4),I.PRM+6(R4)   ;COPY ATTRIBUTE LIST POINTER
	CLR	I.PRM+4(R4)		  ;ASSUME NO BUFFER LENGTH
	MOV	I.PRM(R4),I.PRM+2(R4)	  ;COPY FID POINTER
	CLR	I.PRM(R4)		  ;ASSUME NO BUFFER BIAS
;
; DETERMINE SIZE OF BUFFER TO ALLOCATE
;
	MOV	#7,-(SP)	;SET COUNT OF ATTRIBUTES + 1 - MAX SIX
	MOV	@#KISAR6,-(SP)	;SAVE TASK HEADER MAPPING
	MOV	R5,-(SP)	;GET A WORKING REGISTER
	CLR	-(SP)		;SET SIZE OF CPRBUF ALLOCATION TO ZERO
	TST	I.PRM+2(R4)	;IS THERE A FID?
	BEQ	10$		;IF EQ NO
	ADD	#3.*2+2,(SP)	;ACCOUNT FOR 3 WORD BUFFER PLUS ADDRESS
10$:	TST	I.PRM+16(R4)	;IS THERE AN FNB?
	BEQ	20$		;IF EQ NO
	ADD	#15.*2+2,(SP)	;ACCOUNT FOR 15 WORD BLOCK PLUS ADDRESS
20$:
;
; CALCULATE SIZE OF ALL THE ATTRIBUTE BUFFERS
;
	MOV	I.PRM+6(R4),R3	;GET ADDRESS OF ATTRIBUTE LIST
	BEQ 	70$		;IF EQ NONE
	
	MOV	#SAVATT,R5	;ADDRESS OF SAVED ATTRIBUTE AREA
30$:	DEC 	6(SP)		;DECCREMENT NUMBER OF ATTRIBUTES COUNTER
	BEQ	40$		;NO MORE
	MOV	R3,R0		;GET ADDRESS OF NEXT ATTRIBUTE
	MOV	#4,R1		;SET SIZE OF ATTRIBUTE
	CALL	$ACHCK		;ADDRESS CHECK ATTRIBUTE DESCRIPTOR
	BCS	IESPC		;IF CS ERROR
	CALL	$RELOM		;RELOCATE AND MAP
	ADD	#4,R3		;POINT TO NEXT ATTRIBUTE
	MOV	(R0),(R5)+	;SAVE THE ATTRIBUTE TYPE AND SIZE
	BEQ	40$		;IF EQ NO ATTRIBUTE
	ADD	#6,(SP)		;INCLUDE ATTRIBUTE IN SIZE
	MOV	#512.,R2	;ASSUME FULL BLOCK
	CMP	#366,(R0)+	;IS THIS "READ ENTIRE FILE HEADER"?
	BEQ	35$		;YES, SIZE IS CORRECT
	MOVB	-1(R0),R2	;GET THE SIZE OF THE ATTRIBUTE
	EVEN	R2		;ROUND TO NEXT WORD
35$:	MOV	(R0),(R5)+	;COPY THE BUFFER ADDRESS TO THE SAVED AREA
	CMP	R2,$CPMXB	;IS IT TOO BIG TO GO INTO THE BUFFER?
	BHI	30$		;IF HI OR SAME, YES
	ADD	R2,(SP)		;INCLUDE IT IN THE TOTAL
	ADD	#2,(SP)		;INCLUDE SPACE FOR USER ADDRESS
	BR	30$		;LOOK AT NEXT ATTRIBUTE
40$:	ADD	#2,(SP)		;ACCOUNT FOR END OF LIST WORD
	CLR	(R5)+		;INSERT 0 AT END OF LIST
70$:	MOV	(SP)+,R1	;GET SIZE OF BUFFER
	MOV	(SP)+,R5	;RESTORE POLISH DISPATCH REGISTER
	MOV	(SP)+,@#KISAR6	;RECOVER TASK HEADER MAPPING
	TST	(SP)+		;CLEAN STACK OF ATTRIBUTE COUNT
	TST	R1		;WAS ANY BUFFER NECESSARY?
	BEQ	PKTDON		;NOPE, ALL DONE
75$:	MOV	R1,I.PRM+4(R4)	;SET LENGTH OF BUFFER IN I/O PACKET
;
; ALLOCATE A BUFFER FROM CPRBUF
;
80$:	ADD	#177,R1		;ROUND SIZE TO NEAREST 32, ADD ONE FOR HEADER
	ASH	#-6,R1		; WORD BLOCK
	CLR	R0		;NO FLAGS
	CALL	$CPALO		;ALLOCATE A BUFFER FROM CPRBUF
	BCS	IENOD		;IF CS ALLOCATION FAILED

	MOV	R0,@$TEMP0	;SAVE BIAS ON STACK
	MOV	R0,I.PRM(R4)	;PUT BIAS IN FIRST PARAMETER
	MOV	#MAP6+100,R3	;POINT TO SECOND BLOCK FOR BUFFERS
;
; BUILD FID 
;
	MOV	I.PRM+2(R4),R0	;SET ADDRESS OF FILE ID BLOCK
	BEQ	90$		;IF EQ NONE
	MOV	#100000,I.PRM+2(R4);INDICATE THAT FID EXISTS (OFFSET 0 IMPLIED)
	MOV	#3*2,R1		;SET LENGTH OF FILE ID BLOCK
	CALL	INP.RW		;INSERT FILE ID BLOCK
90$:
;
; BUILD FILE NAME BLOCK
;
	MOV	I.PRM+16(R4),R0	;SET ADDRESS OF FILE NAME BLOCK
	BEQ	100$		;IF EQ NONE
	MOV	R3,I.PRM+16(R4) ;PUT OFFSET INTO I/O PACKET
	BIC	#MAP6,I.PRM+16(R4) ;GET RID OF APR6 BIAS BITS
	MOV	#15.*2,R1	;SET LENGTH OF FILE NAME BLOCK
	CALL	INP.RW		;INSERT FILE NAME BLOCK
100$:
;
; BUILD ATTRIBUTE POINTER BLOCK
;
; FIRST COPY THE ATTRIBUTE BLOCK, LEAVING A EXTRA WORD AFTER EACH BUFFER 
; ADDRESS.  THIS WILL ALLOW THE ADDRESS TO BE EXPANDED TO A BIAS/OFFSET PAIR.
;

ATRBK:	TST	I.PRM+6(R4)	;ATTRIBUTE DESCRIPTOR BLOCK 
	BEQ	PKTDON		;NOT SPECIFIED? IF EQ NO

	MOV	R3,I.PRM+6(R4)	;PUT OFFSET INTO I/O PACKET
	BIC	#MAP6,I.PRM+6(R4) ;GET RID OF APR6 BIAS BITS

	MOV	@#KISAR6,-(SP)	;SAVE MAPPING
	MOV	I.PRM(R4),@#KISAR6 ;MAP CPR BUFFER

	MOV	#SAVATT,R0	;GET ADDRESS OF SAVED ATTRIBUTE AREA
	MOV	R5,-(SP)	;GET A REGISTER
	MOV	R3,R5		;SAVE THE BEGINNING OF THE ATTRIBUTE LIST
10$:	MOV	(R0)+,(R3)+	;MOVE TYPE AND SIZE
	BEQ	17$		;CLEAR, DONE
	MOV	(R0)+,(R3)+	;MOVE USER ADDRESS
	TST	(R3)+		;EXTRA WORD FOR BIAS/OFFSET PAIR
	BR	10$		;GET NEXT ATTRIBUTE
17$:
;
; INSERT ATTRIBUTES INTO THE BUFFER.  THIS WILL BE DONE FOR EACH ATTRIBUTE IN 
; ONE OF THREE WAYS:
;
;	1) THE ATTRIBUTE IS LARGER THAN $CPMXB.  IT WILL BE ADDRESS CHECKED AND
;	   LOCKED DOWN, AND THE BIAS/OFFSET IN RSX MEMORY WILL BE STORED IN THE
;	   ATTRIBUTE LIST.  THE AME WILL ACCESS THE BUFFER DIRECTLY
;
;	2) THE ATTRIBUTE IS <= $CPMXB, AND IS TO BE WRITTEN TO THE FILE.  THE
;	   ATTRIBUTE WILL BE COPIED INTO CPRBUF.
;
;	3) THE ATTRIBUTE IS <= $CPMXB, AND IS TO BE READ FROM THE FILE.  SPACE
;	   WILL BE ALLOCATE IN THE CPR BUFFER, AND THE USER ADDRESS OF THE 
;	   BUFFER WILL BE APPENDED AFTER THE BUFFER, SO THAT IT CAN BE 
;	   RELOCATED UPON RETURN TO COPY THE DATA TO THE USER BUFFER.
;	
;
	
30$:	TSTB	(R5)		;IS THERE AN ATTRIBUTE HERE?
	BEQ	40$		;IF EQ NO, ALL DONE

	MOV	#512.,R1	;ASSUME FULL SIZE
	CMP	#366,(R5)+	;IS THIS "READ ENTIRE FILE HEADER"?
	BEQ	21$		;YES, CONTINUE
	MOVB	-1(R5),R1	;GET SIZE OF ATTRIBUTE
21$:	MOV	(R5),R0		;GET ADDRESS OF ATTRIBUTE
	CMP	R1,$CPMXB	;SMALL ENOUGH TO BUFFER IN CPR PACKET?
	BHI	25$		;NOPE, JUST CHECK AND RELOCATE

	MOV	#INPR.R,-(SP)	;ASSUME WRITE ATTRIBUTE - READ ONLY ACCESS OK
	TSTB	-2(R5)		;IS THIS A READ ATTRIBUTE?
	BPL	23$		;NOPE, WRITE.  LEAVE ROUTINE ALONE
	MOV	#INPR.W,(SP)	;WRITE ACCESS NECESSARY
23$:	MOV	I.PRM(R4),(R5)+	;BIAS IS BIAS OF CPR PACKET
	MOV	R3,(R5)		;MOVE CURRENT OFFSET
	BIC	#170000,(R5)+	;CLEAR OUT APR PART OF OFFSET
	MOV	4(SP),@#KISAR6	;HEADER MUST BE MAPPED
	CALL	@(SP)+		;MOVE BUFFER
	MOV	I.PRM(R4),@#KISAR6 ;REMAP CPR PACKET
	BR	30$		;GET NEXT ATTRIBUTE	
	
25$:	MOV	#$CKBFR,-(SP)	;ASSUME READ ONLY ACCESS REQUIRED
	TSTB	-2(R5)		;IS THIS READING FROM THE FILE?
	BPL	27$		;NOPE, WRITE ATTRIBUTE
	MOV	#$CKBFB,(SP)	;IT'S READING THE ATTRIBUTE-WE NEED WRITE ACCESS
27$:	MOV	4(SP),@#KISAR6	;HEADER MUST BE MAPPED
	CALL	@(SP)+		;GO LOCK THE BUFFER
	BCS	INERR		;EXIT WITH ERROR
	CALL	$RELOC		;RELOCATE
	MOV	I.PRM(R4),@#KISAR6 ;REMAP CPR PACKET
	MOV	R1,(R5)+	;MOVE THE BIAS
	MOV	R2,(R5)+	;AND THE OFFSET
	BR	30$		;GO GET THE NEXT ATTRIBUTE

40$:	MOV	(SP)+,R5	;RESTORE POLISH DISPATCH
	MOV	(SP)+,@#KISAR6	;REMAP TASK HEADER
PKTDON:
	JMP	@(R5)+
;
; INP.RW: READ/WRITE ACCESS - ADDRESS CHECK AND INSERT PARAMETER BLOCK 
; INPR.W: WRITE ONLY ACCESS - ADDRESS CHECK AND INSERT USER ADDRESS, NO BLXIO
; INPR.R: READ ONLY ACCESS - ADDRESS CHECK AND INSERT IN PARAMETER BLOCK
;
;	INPUTS : R0 - ADDRESS OF BLOCK IN USER'S ADDRESS SPACE
;		 R1 - LENGTH OF BLOCK
;		 R3 - POINTER INTO CPR BUFFER (APR6 ADDRESS)
;
;	OUTPUT:  BUFFER COPIED INTO CPR BLOCK, USER ADDRESS FOLLOWING BUFFER
;		 R0 - OFFSET INTO CPR BUFFER OF START OF BLOCK
;		 R3 - UPDATED TO POINTER AFTER INSERTED BLOCK
;		 R4 IS PRESERVED
;
	.ENABL	LSB
INPR.W:	MOV	#$ACHKB,R2	;ADDRESS CHECK ROUTINE
	CLR	-(SP)		;DON'T DO BLXIO
	BR	3$
INP.RW: MOV	#$ACHKB,R2	;ADDRESS CHECK ROUTINE
	BR	2$
INPR.R: MOV	#$ACHRO,R2	;ADDRESS CHECK READ ONLY
2$:	MOV	I.PRM(R4),-(SP) ;BASE OF CPRBUF
3$:	MOV	R1,-(SP)	;SAVE LENGTH OF BUFFER
	CALL	@R2		;CHECK USER'S BUFFER
	BCS	INERR		;IF CS ERROR
	MOV	(SP),R1		;GET BACK LENGTH
	ADD	R3,R1		;GET OFFSET AT END OF BUFFER
	EVEN	R1		;MOVE TO WORD BOUNDARY
	MOV	@#KISAR6,-(SP)	;SAVE TASK HEADER MAPPING
	MOV	I.PRM(R4),@#KISAR6 ;MAP CPRBUF
	MOV	R0,(R1)		;STORE USER ADDRESS
	MOV	(SP)+,@#KISAR6	;REMAP TASK HEADER
	TST	2(SP)		;DO BLXIO?
	BNE	7$		;YES
	ADD	(SP)+,R3	;ADD LENGTH OF BUFFER
	TST	(SP)+		;CLEAN STACK
	BR	8$		;AND EXIT
;	
; USE BLXIO TO DO COPY
;
7$:	CALL	$RELOC		;RELOCATE BUFFER
	SUB	#MAP6-MAP5,R2	;MAKE OFFSET FROM APR5
	MOV	R4,R0		;SAVE IO PACKET ADDRESS FOR A SECOND
	MOV	R3,R4		;GET OFFSET INTO CPRBUF
	MOV	2(SP),R3	;GET BIAS OF CPRBUF
	MOV	R0,2(SP)	;SAVE THE IO PACKET ON THE STACK
	MOV	(SP)+,R0	;RESTORE LENGTH
	CALL	$BLXIO		;COPY BUFFER
	MOV	R4,R3		;PUT UPDATED POINTER INTO R3
	MOV	(SP)+,R4	;RESTORE IO PACKET ADDRESS
8$:	EVEN	R3		;MOVE TO WORD BOUNDARY
	ADD	#2,R3		;UPDATE POINTER PAST USER ADDRESS
	RETURN
	.DSABL LSB

INERR:  
	JMP	IESPC		;RETURN WITH ERROR
;
; LOCK HEADER IN MEMORY DURING ACP FUNCTION
;

CKLHD:  MOV	$TKTCB,R0	;GET CURRENT TASK TCB ADDRESS
	MOV	T.ATT(R0),R0	;GET ATTACHMENT DESCRIPTOR
	INCB	A.IOC-A.TCBL(R0) ;BUMP I/O COUNT FOR TASK REGION
	MOV	A.PCB-A.TCBL(R0),R0 ;GET ADDRESS OF TASK REGION
	INCB	P.IOC(R0)	;BUMP REGION'S I/O COUNT
	BISB	#200,I.EFN(R4)	;FLAG REQUEST AS A VIRTUAL I/O REQUEST
	JMP	@(R5)+		;

;
; SET .RSW IN TCB TO BLOCK TASK UNTIL OPERATION IS COMPLETE OR AT LEAST
; PAST PORTION THAT NEEDS TO APPEAR SYNCHRONOUS.
;
SETRSW:
	MOV	I.TCB(R4),R1		; GET TCB ADDRESS.
	BIS	#TS.RSW,T.STAT(R1)	; BLOCK TASK TO MAKE IT SYNCHRONOUS.
	JMP	@(R5)+		; GO TO NEXT ENTRY IN DISPATCH TABLE.

;
; EXIT WITH EITHER ONE OR NO BITS SET IN THE FLAG WORD, OR THE WORD AS
; SPECIFIED IN R1.
;
	.ENABL LSB
CKNXT:				; USE R1 FOR BUFFER FLAGS.
	MOV	R1,R0		; GET BUFFER FLAGS.
	BR	10$		; CONTINUE IN COMMON CODE.
CK1XC:  TST	I.PRM(R4)	;IS THERE A BUFFER?
	BNE	CK1XT		;IF NE YES
CK0XT:	CLR	R0		;NO BUFFERS
	BR	10$		;JOIN COMMON CODE
CK1XT:	MOV	#1,R0		;ONE BUFFER
10$:
	.DSABL LSB
;
; CALCULATE LUN NUMBER 
;
	MOV	I.LN2(R4),R3    ;GET POINTER TO 2ND LUN WORD
	SUB	#<MAP6+H.LUN+2>,R3 ;GET OFFSET INTO LUT
	ASR	R3		;DIVIDE BY 4 (4 BYTES PER LUN ENTRY)
	ASR	R3		;
	INC 	R3		;LUN NUMBERS START AT 1
	MOVB	R3,I.LN2(R4)    ;RETURN TO LUN FIELD IN I/O PACKET
;
; FILL IN BUFFER FLAG
;
	MOVB	R0,I.LN2+1(R4)  ;
;
; EXIT POLISH TO FUNCTION EXIT
;

	TST	(SP)+		;REMOVE ADDRESS OF SECOND LUN WORD
	MOV	(SP)+,R5	;RETRIEVE UCB ADDRESS
	TST	(SP)+		;WAS THERE A CPR PACKET ALLOCATED?
	BEQ	20$		;NOPE, CONTINUE
	BIS	#100000,I.LN2(R4) ;MARK THAT CPRBUF ALLOCATED
20$:	TST	(SP)+		;CLEAN OFF ERROR STACK

	MOV	U.SCB(R5),R0    ;GET I/O QUEUE LISTHEAD
	MOV	R4,R1		;GET PACKET POINTER
	CALLR	$QINSP		;INSERT PACKET

	.END